home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-15 / ctest257.zip / COMPTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1992-09-28  |  55KB  |  1,449 lines
  1. {$A+,B-,D-,E+,F-,G-,I-,L-,N+,O-,R-,S-,V-,X-}
  2. {$M 4096,0,655360}
  3. USES DOS, Crt, Time, Whet, Dhry, LLL, Caches;
  4.  
  5. CONST
  6.    MaxBufSize= 65500;
  7.    ClockFreq = 1.193182e6;
  8.  
  9.  
  10. TYPE
  11.    LongWord  = ARRAY [1..2] OF WORD;
  12.    IOPuffer  = ARRAY [1..MaxBufSize] OF BYTE;
  13.    PufferZgr = ^IOPuffer;
  14.    Processor = (NA, i88, i86, V20, V30, i188, i186, i286, i386, i386sx, ct386,
  15.                 ct386sx, c486dlc, c486slc, rapidcad, i486, i486sx);
  16.    CardType  = (MDA, CGA, Herkules, EGA, MCGA, VGA, PGA);
  17.    ResultRec = RECORD
  18.                   CPUType: BYTE;
  19.                   NDPType: BYTE;
  20.                   AAMTime: INTEGER;
  21.                   Dummy1:  INTEGER;
  22.                   MoveWTime,
  23.                   BIOSWriteTime, MoveBTime, EMS_Time, Ext_Time, ScreenFillTime,
  24.                   Dummy2, Speed87, Speed287, MoveDTime: INTEGER;
  25.                END;
  26.  
  27.  
  28.  
  29. CONST
  30.    SIOBase:     ARRAY [1..4] OF WORD =
  31.                 ($3F8, $2F8, $3E8, $2E8);
  32.    SIOTypeStr:  ARRAY [1..5] OF STRING [7] =
  33.                 ('8250', '16450', '16550', '16550A', 'unknown');
  34.    BusWidth:    ARRAY [i88 .. i486sx] OF BYTE =
  35.                 (8, 16, 8, 16, 8, 16, 16, 32, 16, 32, 16,
  36.                  32, 16, 32, 32, 32);
  37.    AAM_Time:    ARRAY [i88 .. i486sx] OF INTEGER =
  38.                 (77, 77, 15, 15, 19, 19, 16, 17, 17, 16, 16,
  39.                  17, 17, 15, 15, 15);
  40.    FillTime:    ARRAY [i88 .. i486sx] OF INTEGER =
  41.                 (10, 10, 4, 4, 9, 9, 3, 5, 5, 5, 5,
  42.                 4, 4, 4, 4, 4);
  43.    MoveTime:    ARRAY [i88 .. i486sx] OF INTEGER =
  44.                 (25, 17, 8, 16, 8, 16, 4, 4, 8, 4, 8,
  45.                 4, 4, 5, 3, 3);
  46.    LFaktor:     ARRAY [i88 .. i486sx] OF REAL =
  47.                 (1, 1.45, 1.15, 1.78, 1.15, 1.78, 3.3, 4.1, 3.4,
  48.                  4.5, 3.7, 5.0, 6.0, 6.5, 8.5, 8.5);
  49.    CPU_Name:    ARRAY [i88 .. i486sx] OF STRING [15] =
  50.                 ('Intel 8088', 'Intel 8086', 'NEC V20', 'NEC V30',
  51.                  'Intel 80188', 'Intel 80186', 'Intel 80286',
  52.                  'Intel 80386', 'Intel 80386SX', 'C&T 38600DX',
  53.                  'C&T 38600SX', 'Cyrix 486DLC', 'Cyrix 486SLC',
  54.                  'Intel RapidCAD', 'Intel 80486',
  55.                  'Intel 80486SX');
  56.    CoProcessor: ARRAY [0 .. 27] OF STRING [19] =
  57.                 ('NOT INSTALLED', 'Emulation via INT 7', 'Intel 8087',
  58.                  'Intel 80C187', 'Intel 80287', 'Intel 80287XL', 'Intel 80387',
  59.                  'Intel 80387sx', 'IIT 2C87', 'IIT 2C87', 'IIT 3C87',
  60.                  'IIT 3C87sx', 'Cyrix 82S87 (old)', 'Cyrix 82S87 (old)',
  61.                  'Cyrix 83D87', 'Cyrix 83S87 (old)', 'ULSI 83C87', 'ULSI 83S87',
  62.                  'C&T 38700DX', 'C&T 38700SX', 'Intel 80387DX', 'Intel RapidCAD',
  63.                  'Intel 486', 'Cyrix 82S87 (new)', 'Cyrix 82S87 (new)',
  64.                  'Cyrix 387+', 'Cyrix 83S87 (new)', 'Cyrix EMC87');
  65.    Installed:   ARRAY [FALSE..TRUE] OF STRING [13] =
  66.                 ('NOT INSTALLED', 'INSTALLED');
  67.    Computer:    ARRAY [$F5..$FF] OF STRING [14] =
  68.                 ('PS/2 Model 60', 'PS/2 Model 50', 'XT-286', 'PS/2 Model 80',
  69.                  'Laptop', 'PS/2 Model 30', 'XT', 'AT', 'PCjr', 'XT / Portable',
  70.                  'PC');
  71.    CardMemBegin:ARRAY [MDA .. PGA] OF WORD =
  72.                 ($B000, $B800, $B000, $A000, $A000, $A000, $A000);
  73.    CardName:    ARRAY [MDA .. PGA] OF STRING [37] =
  74.                 ('Monochrome Display Adapter (MDA)',
  75.                  'Color Graphics Adapter (CGA)',
  76.                  'Hercules Graphics Card (HGC)',
  77.                  'Enhanced Graphics Adapter (EGA)',
  78.                  'Multi Color Graphics Array (MCGA)',
  79.                  'Video Graphics Array (VGA)',
  80.                  'Professional Graphics Adapter (PGA)');
  81.  
  82.  
  83. VAR
  84.    SIOType:                                         ARRAY [1..4] OF BYTE;
  85.  
  86.    SIOCtrl, SIOStat, SerOut, DataWidth, SaveByte,
  87.    ConfigStatHi, ConfigStatLo, DOS_Drives,
  88.    NrOfHardDisks, NrOfFloppies, EGAInfo, DriveByte,
  89.    ErrByte, NrHD, NrDD, Nr3DD, Nr3HD, Drive1,
  90.    Drive2, Typ, Head1, K:                           BYTE;
  91.  
  92.    MemExists, GamesAdaptor, MousePresent,
  93.    ExtendedMem, ExpandedMem, MonoChromMode,
  94.    Disktest, OldMemExists, ExtraRAMFound, EGAPres,
  95.    VGAPres, ANSIPresent, Debug, Emu, Weitek,
  96.    PortExists:                                      BOOLEAN;
  97.  
  98.    Ch:                                              CHAR;
  99.  
  100.    ScreenWaits, Segment, OldSegment, NrParallelPorts,
  101.    NrSerialPorts, DefaultDr, ExtendedMemSize,
  102.    ExpandedMemSize, SystemMemory, L, DOS_Memory,
  103.    EGAMem, UsedMemory, BufSeg, BufOff, Head,
  104.    Dummy, Track, RAMBeg, ROMSize, EMS_Base,
  105.    FillSize, FirstLevel, SecondLevel, SPC,
  106.    SegTest, OfsTest, ChkSum:                        WORD;
  107.  
  108.    Start, DOSWriteTime, BIOSWriteTime, SavedTime,
  109.    CacheTstTime, HeapPointer:                       LONGINT;
  110.  
  111.    MoveTakte, MoveWTakte, FillTakte, Frequency,
  112.    Waitstates, Cache2Thru, Frequency87, Durchsatz,
  113.    EMS_Thruput, Ext_Thruput, DOSSpeed, CacheThru,
  114.    MemThru, BIOSSpeed, Index, Version, ThruPut:     REAL;
  115.  
  116.    MegaFlops, Dhrys, Whets:                         DOUBLE;
  117.    Fil:                                             TEXT;
  118.    EMS_Version:                                     STRING [3];
  119.    ComputerType, ScreenType:                        STRING [35];
  120.    ProcessorType:                                   STRING [15];
  121.    DiskTypeStr, DriveStr:                           STRING [45];
  122.    TestStr:                                         STRING [86];
  123.    ScreenAddr:                                      POINTER;
  124.    CPU:                                             Processor;
  125.    GraphCard:                                       CardType;
  126.    Regs:                                            Registers;
  127.    Result:                                          ResultRec;
  128.    DummyPtr, BufPtr:                                PufferZgr;
  129.    MoveBuffer:                                      POINTER;
  130.    Heads, Sectors, DOSCylinders, Tracks, Cylinders: ARRAY [$80..$83] OF WORD;
  131.    Capacity, CylSize:                               ARRAY [$80..$83] OF LONGINT;
  132.    Valid:                                           ARRAY [$80..$83] OF BOOLEAN;
  133.    MaximumAccess, AverageAccess, TrackToTrack,
  134.    DiskThruPut:                                     ARRAY [$80..$83] OF REAL;
  135.    CacheOn:                                         ARRAY [$80..$83] OF BOOLEAN;
  136.    InfoBuf:                                         ARRAY [0..64] OF BYTE;
  137.  
  138.  
  139.  
  140. {$L CCNEW.OBJ}
  141.  
  142. PROCEDURE SpeedTest (Debg, Ext_Flag, EMS_Flag: WORD;
  143.                      EPtr, Bptr, Sptr: POINTER;
  144.                      VAR Results: ResultRec); NEAR; EXTERNAL;
  145.  
  146.  
  147.  
  148. FUNCTION EMM_Installed: BOOLEAN;
  149.  
  150. VAR
  151.   EMM_Name: String[8];
  152.   Regs    : Registers;
  153.  
  154. BEGIN
  155.    EMM_Name := '        ';
  156.    Regs.AH := $35;
  157.    Regs.AL := $67;
  158.    Intr ($21, Regs);
  159.    Move (Mem [Regs.ES:$0A], EMM_Name[1], 8);
  160.    EMM_Installed := (EMM_Name = 'EMMXXXX0');
  161. END;
  162.  
  163.  
  164.  
  165. FUNCTION EMS_Memory: INTEGER;
  166. VAR Regs: Registers;
  167. BEGIN
  168.     Regs.AH    := $42;
  169.     Intr ($67, Regs);
  170.     EMS_Memory := Regs.DX * 16;
  171. END;
  172.  
  173.  
  174. FUNCTION GetEMSVersion: STRING;
  175. VAR Regs: Registers;
  176. BEGIN
  177.    Regs.AH := $46;
  178.    Intr ($67, Regs);
  179.    GetEMSVersion := Char (Regs.AL SHR 4 + 48) + '.' + Char(Regs.AL AND $F +48); { dito für Neben-Versionsnummer }
  180. END;
  181.  
  182.  
  183.  
  184. FUNCTION CheckMouse: BOOLEAN;
  185. VAR Regs: Registers;
  186. BEGIN
  187.    Regs.AX := 5;                 { get button press information (destroys AX) }
  188.    Regs.BX := 0;                 { left button }
  189.    Intr ($33, Regs);
  190.    CheckMouse := (Regs.AX <> 5);
  191. END;
  192.  
  193.  
  194.  
  195. FUNCTION GetEMSBase: WORD;
  196. VAR Regs: Registers;
  197. BEGIN
  198.    Regs.AH := $41;
  199.    Intr ($67, Regs);
  200.    GetEMSBase := Regs.BX;
  201. END;
  202.  
  203.  
  204.  
  205. {$F+}
  206. FUNCTION HeapFunc (Size: WORD): INTEGER;
  207. {$F-}
  208. BEGIN
  209.    HeapFunc := 1;
  210. END;
  211.  
  212.  
  213.  
  214. FUNCTION HercPresent: BOOLEAN;
  215. BEGIN
  216.    Inline($BB/$00/$01/$BA/$BA/$03/$EC/$88/$C4/$80/$E4/$80/$B9/$40/$00/$EC/
  217.           $24/$80/$38/$E0/$E1/$F9/$75/$05/$4B/$75/$F1/$EB/$33/$B8/$00/$B0/
  218.           $8E/$C0/$E8/$11/$00/$75/$0B/$B0/$01/$BA/$BF/$03/$EE/$E8/$06/$00/
  219.           $74/$1E/$B0/$01/$EB/$1C/$26/$8A/$1E/$FF/$7F/$26/$8A/$0E/$FF/$3F/
  220.           $26/$FE/$06/$FF/$3F/$26/$3A/$1E/$FF/$3F/$26/$88/$0E/$FF/$3F/$C3/
  221.           $30/$C0/$88/$46/$FF/$08/$C0);
  222. END;
  223.  
  224.  
  225. FUNCTION Hex (X: WORD): STRING;
  226. VAR H: ARRAY [0..15] OF CHAR;
  227. BEGIN
  228.    H := '0123456789ABCDEF';
  229.    Hex := H [X SHR 12] + H [(X AND $0F00) SHR 8] +
  230.           H [(X AND $00F0) SHR 4] + H [(X AND $000F)];
  231. END;
  232.  
  233.  
  234.  
  235. PROCEDURE SearchExtraRAM (FileWrite: BOOLEAN);
  236. BEGIN
  237.    ExtraRAMFound := FALSE;
  238.    IF SystemMemory * 64 < CardMemBegin [GraphCard] THEN
  239.       Segment := SystemMemory * 64
  240.    ELSE
  241.       Segment := $C000;
  242.    MemExists := FALSE;
  243.    WHILE Segment < $FC00 DO BEGIN
  244.       Inline ($54/$58/$3B/$C4/$74/$0C/$B0/$00/$E6/$A0/
  245.               $E4/$61/$0C/$30/$E6/$61/$EB/$0E/$E4/$70/
  246.               $0C/$80/$E6/$70/$E4/$71/$E4/$61/$0C/$0C/
  247.               $E6/$61/$FA);
  248.       OldMemExists := MemExists;
  249.       SaveByte := Mem [Segment:0];
  250.       Mem [Segment:0] := $55;
  251.       Dummy := Mem [Segment:0];
  252.       MemExists := (Dummy = $55);
  253.       Mem [Segment:0] := $AA;
  254.       Dummy := Mem [Segment:0];
  255.       MemExists := MemExists AND (Dummy = $AA);
  256.       Mem [Segment:0] := SaveByte;
  257.       Inline ($54/$58/$3B/$C4/$74/$0C/$E4/$61/$34/$30/
  258.               $E6/$61/$B0/$80/$E6/$A0/$EB/$0E/$E4/$61/
  259.               $34/$0C/$E6/$61/$E4/$70/$24/$7F/$E6/$70/
  260.               $E4/$71/$FB);
  261.       IF Segment = EMS_Base THEN
  262.          MemExists := FALSE;
  263.       IF Segment = CardMemBegin [GraphCard] THEN
  264.          MemExists := FALSE;
  265.       IF MemExists AND (NOT OldMemExists) THEN BEGIN
  266.          ExtraRAMFound := TRUE;
  267.          RAMBeg := Segment;
  268.          END;
  269.       IF (NOT MemExists) AND OldMemExists THEN BEGIN
  270.          IF FileWrite THEN
  271.             Write (Fil, Hex (RAMBeg)+'0', '-', Hex (Segment-1)+'F (',
  272.                   (Segment-RAMBeg) DIV 64:3 , ' kB)', #13#10, ' ':37)
  273.          ELSE
  274.             Write (Hex (RAMBeg)+'0', '-', Hex (Segment-1)+'F (',
  275.                   (Segment-RAMBeg) DIV 64:3 , ' kB)', #13#10, ' ':37);
  276.          END;
  277.       IF Segment = CardMemBegin [GraphCard] THEN
  278.          Segment := $BFF0;
  279.       IF Segment = EMS_Base THEN BEGIN
  280.          IF FileWrite THEN
  281.             Write (Fil, Hex (EMS_Base)+'0', '-', Hex (EMS_Base+$0FFF)+'F ( 64 kB)',
  282.                    ' EMS-frame', #13#10, ' ':37)
  283.          ELSE
  284.             Write (Hex (EMS_Base)+'0', '-', Hex (EMS_Base+$0FFF)+'F ( 64 kB)',
  285.                    ' EMS-frame', #13#10, ' ':37);
  286.          Inc (Segment, $1000);
  287.          END
  288.       ELSE
  289.          Inc (Segment, $10);
  290.    END;
  291.    IF (NOT ExtraRAMFound) AND ((NOT ExpandedMem) OR (EMS_BASE > $F000)) THEN
  292.       IF FileWrite THEN
  293.          WriteLn (Fil, 'NOT FOUND')
  294.       ELSE
  295.          WriteLn ('NOT FOUND');
  296. END;
  297.  
  298.  
  299. PROCEDURE SearchROM (FileWrite: BOOLEAN);
  300. VAR Vector_41: POINTER;
  301.     Vector_57: POINTER;
  302. BEGIN
  303.    GetIntVec ($41, Vector_41);
  304.    GetIntVec ($57, Vector_57);
  305.    ExtraRAMFound := FALSE;
  306.    Segment := $C000;
  307.    OldSegment := 0;
  308.    WHILE (Segment < $F000) AND (OldSegment < Segment) DO BEGIN
  309.       OldSegment := Segment;
  310.       IF MemW [Segment:0] = $AA55 THEN BEGIN
  311.          ROMSize := Mem [Segment:2] DIV 2;
  312.          Inline ($FC/$8B/$0E/ROMSize/$86/$CD/$D1/$E1/$D1/$E1/$31/
  313.                  $F6/$89/$F3/$A1/Segment/$1E/$8E/$D8/$AC/$00/$C3/
  314.                  $E2/$FB/$1F/$89/$1E/ChkSum);
  315.          IF ChkSum = 0 THEN BEGIN
  316.             ExtraRAMFound := TRUE;
  317.             IF FileWrite THEN
  318.                Write (Fil, Hex(Segment)+'0', '-', Hex(Segment+ROMSize * 64-1)+'F (',
  319.                       ROMSize:3, ' kB)')
  320.             ELSE
  321.                Write (Hex(Segment)+'0', '-', Hex(Segment+ROMSize * 64-1)+'F (',
  322.                       ROMSize:3, ' kB)');
  323.             IF (Seg(Vector_41^) = Segment) THEN
  324.                 IF FileWrite THEN
  325.                    Write (Fil, ' Harddisk-BIOS')
  326.                 ELSE
  327.                    Write (' Harddisk-BIOS');
  328.              IF (Segment = Seg(Vector_57^)) THEN
  329.                 IF FileWrite THEN
  330.                    Write (Fil, ' NetBIOS-ROM')
  331.                 ELSE
  332.                    Write (' NetBIOS-ROM');
  333.              IF (Segment = $C000) THEN
  334.                 IF VGAPres THEN
  335.                    IF FileWrite THEN
  336.                       Write (Fil, ' VGA-BIOS')
  337.                    ELSE
  338.                       Write (' VGA-BIOS')
  339.                 ELSE IF EGAPres THEN
  340.                    IF FileWrite THEN
  341.                       Write (Fil, ' EGA-BIOS')
  342.                    ELSE
  343.                       Write (' EGA-BIOS');
  344.             IF FileWrite THEN
  345.                Write (Fil, #13#10, ' ':37)
  346.             ELSE
  347.                Write (#13#10, ' ':37);
  348.             Inc (Segment, ROMSize * 64)
  349.             END
  350.          ELSE
  351.             Inc (Segment, $10);
  352.          END
  353.       ELSE
  354.          Inc (Segment, $10);
  355.     END;
  356.     IF NOT ExtraRAMFound THEN
  357.        IF FileWrite THEN
  358.           WriteLn (Fil, 'NOT FOUND')
  359.        ELSE
  360.           WriteLn ('NOT FOUND');
  361. END;
  362.  
  363.  
  364.  
  365. PROCEDURE ReserveMem;
  366. BEGIN
  367.    BufPtr := NIL;
  368.    IF CylSize [L] > LongInt (MaxBufSize) THEN BEGIN
  369.       SPC := MaxBufSize DIV 512;
  370.       CylSize [L] := SPC * 512;
  371.       END;
  372.    HeapPointer := LONGINT (LongWord(HeapPtr)[2]) * 16 + LongWord(HeapPtr)[1];
  373.    FillSize := $10000 - HeapPointer MOD $10000;
  374.    GetMem (DummyPtr, FillSize);
  375.    IF DummyPtr = NIL THEN BEGIN
  376.       WriteLn (#13#10#10'Not enough memory to test hard disk(s)');
  377.       Halt;
  378.    END;
  379.    GetMem (BufPtr, Word (CylSize[L]+16));
  380.    IF BufPtr = NIL THEN BEGIN
  381.       WriteLn (#13#10#10'Not enough memory to test hard disk(s)');
  382.       Halt;
  383.       END;
  384. END;
  385.  
  386.  
  387.  
  388. BEGIN
  389.    Debug := (ParamStr (ParamCount) = '-D') OR (ParamStr (ParamCount) = '-d') OR
  390.             (ParamStr (ParamCount) = '/D') OR (ParamStr (ParamCount) = '/d');
  391.    IF (ParamStr (ParamCount) = '-H') OR (ParamStr (ParamCount) = '-h') OR
  392.       (ParamStr (ParamCount) = '/H') OR (ParamStr (ParamCount) = '/h') OR
  393.       (ParamStr (ParamCount) = '/?') OR (ParamStr (ParamCount) = '-?') THEN BEGIN
  394.        WriteLn (#10#13, 'COMPTEST tests the performance of your PC compatible computer');
  395.        WriteLn (#10#13, 'usage: COMPTEST [file name] [/D] [/H]');
  396.        WriteLn (#10#13, 'file name: saves the test results in file specified');
  397.        WriteLn (        '/D:        enables additional debugging messages');
  398.        WriteLn (        '/H:        displays this information');
  399.        WriteLn;
  400.        Halt (0);
  401.        END;
  402.  
  403.    Regs.AH := 0;                         { switch off diskette motor }
  404.    Regs.DL := 0;                         { recalibrate diskettes only }
  405.    Intr ($13, Regs);
  406.  
  407.    DirectVideo := TRUE;
  408.    CheckBreak  := FALSE;
  409.  
  410.    HeapError := @HeapFunc;
  411.  
  412.    GetMem (MoveBuffer, 20000);
  413.    IF MoveBuffer = NIL THEN BEGIN
  414.       WriteLn ('Not enough memory to execute COMPTEST');
  415.       Halt;
  416.       END;
  417.  
  418.    WITH Result DO BEGIN
  419.  
  420.    {-------------------------------------------------------------------------
  421.      determine computer type
  422.    --------------------------------------------------------------------------}
  423.  
  424.    Typ := Mem [$FFFF:$000E];
  425.    Regs.AH := $C0;                       { get system description table }
  426.    Intr ($15, Regs);
  427.    IF Debug AND ((Regs.Flags AND FCarry) = 0) THEN BEGIN
  428.       WriteLn ('computer type: ', Hex (MemW [Regs.ES:Regs.BX+2]));
  429.       ReadLn;
  430.       END;
  431.    IF ((Regs.Flags AND FCarry) = 0) AND (Mem [Regs.ES:Regs.BX+2] = $FC) THEN
  432.       CASE Mem [Regs.ES:Regs.BX+3] OF
  433.          $02: Typ := $F7;                { XT-286 }
  434.          $04: Typ := $F6;                { PS/2 Model 50 }
  435.          $05: Typ := $F5;                { PS/2 Model 60 }
  436.       END;
  437.    IF Typ < $F5 THEN
  438.       ComputerType := 'Unknown'
  439.    ELSE
  440.       ComputerType := 'IBM ' + Computer [Typ] + ' or compatible';
  441.  
  442.  
  443.    {-------------------------------------------------------------------------
  444.      determine equipment
  445.    --------------------------------------------------------------------------}
  446.  
  447.    Intr ($11, Regs);                     { get BIOS equipment flag }
  448.    NrParallelPorts := (Regs.AH AND $C0) SHR 6;
  449.    GamesAdaptor    := (Regs.AH AND $10) <> 0;
  450.    NrSerialPorts   := (Regs.AH AND $6) SHR 1;
  451.    NrOfFloppies    := (Regs.AL AND $C0) SHR 6 + (Regs.AL AND 1);
  452.    MousePresent    := CheckMouse;
  453.  
  454.    IF NOT GamesAdaptor THEN
  455.       GamesAdaptor := (Port [$201] AND $F) = 0;
  456.  
  457.    IF Debug THEN WriteLn ('About to perform SIO-Test');
  458.  
  459.    Dummy := 0;
  460.    FOR L := 1 TO 4 DO BEGIN
  461.       SIOType [L] := 0;
  462.       SIOCtrl := Port [SIOBase [L] + 4];
  463.       Port [SIOBase [L] + 4] := SIOCtrl OR $10;
  464.       SIOStat := Port [SIOBase [L] + 6];
  465.       Port [SIOBase [L] + 4] := $1A;
  466.       SerOut := Port [SIOBase [L] + 6] AND $F0;
  467.       Port [SIOBase [L] + 4] := SIOCtrl;
  468.       Port [SIOBase [L] + 6] := SIOStat;
  469.       IF SerOut = $90 THEN BEGIN
  470.          Inc (Dummy);
  471.          SIOType [L] := 1;
  472.          K := Port [SIOBase [L]+7];
  473.          IF K = Port [SIOBase [L]+7] THEN BEGIN
  474.             PortExists := TRUE;
  475.             FOR K := 0 TO 255 DO BEGIN
  476.                 Port [SIOBase [L]+7] := K;
  477.                 Delay (1);
  478.                 PortExists := PortExists AND (K = Port [SIOBase [L]+7]);
  479.             END;
  480.             IF PortExists THEN BEGIN
  481.                Inc (SIOType [L]);
  482.                Port [SIOBase [L] + 2] := $01;
  483.                SIOStat := Port [SIOBase [L] + 2] AND $C0;
  484.                IF SIOStat = $C0 THEN
  485.                   SIOType [L] := 4
  486.                ELSE IF SIOStat = $80 THEN
  487.                   SIOType [L] := 3
  488.                ELSE IF SIOStat = 0 THEN
  489.                   SIOType [L] := 2
  490.                ELSE
  491.                   SIOType [L] := 5;
  492.                Port [SIOBase [L] + 2] := 0;
  493.                END; { if portexists...}
  494.             END; { if k...}
  495.          END; { if serout...}
  496.    END; { for l ... }
  497.  
  498.    IF Dummy > NrSerialPorts THEN
  499.       NrSerialPorts := Dummy;
  500.  
  501.  
  502.    {-------------------------------------------------------------------------
  503.      determine graphics card
  504.    --------------------------------------------------------------------------}
  505.  
  506.    Regs.AX := $1B00;                     { get VGA state information }
  507.    Regs.BX := 0;                         { implementation type }
  508.    Regs.ES := Seg (InfoBuf);             { buffer for }
  509.    Regs.DI := Ofs (InfoBuf);             { return information }
  510.    Intr ($10, Regs);                     { try to call VGA Bios }
  511.    VGAPres := (Regs.AL = $1B);           { VGA if AL = AH on return }
  512.  
  513.    Regs.AH := $12;                       { get EGA hardware configuration }
  514.    Regs.BX := $FF10;
  515.    Intr ($10, Regs);                     { try to call EGA Bios }
  516.    EGAPres := (Regs.BH <> $FF);          { EGA, if BH <> $FF }
  517.    EGAMem  := Lo (Regs.BX) * 64 + 64;    { size of EGA screen memory in kB }
  518.  
  519.    Regs.AH := $0F;                       { get screen status }
  520.    Intr ($10, Regs);                     { BIOS video interupt }
  521.    MonoChromMode := Regs.AL = 7;
  522.  
  523.    Regs.AX := $1A00;                     { get screen combination code }
  524.    Intr ($10, Regs);                     { call PS/2 BIOS }
  525.    IF (Regs.AL = $1A) AND (Regs.BL>= $A) AND (Regs.BL <= $C) THEN
  526.       GraphCard := MCGA
  527.    ELSE IF (Regs.AL = $1A) AND (Regs.BL = 6) THEN
  528.       GraphCard := PGA
  529.    ELSE IF MonoChromMode THEN
  530.       IF VGAPres THEN
  531.          GraphCard := VGA
  532.       ELSE IF EGAPres THEN
  533.          GraphCard := EGA
  534.       ELSE IF HercPresent THEN
  535.          GraphCard := Herkules
  536.       ELSE
  537.          GraphCard := MDA
  538.    ELSE
  539.       IF VGAPres THEN
  540.          GraphCard := VGA
  541.       ELSE IF EGAPres THEN
  542.          GraphCard := EGA
  543.       ELSE
  544.          GraphCard := CGA;
  545.  
  546.  
  547.    {-------------------------------------------------------------------------
  548.      determine memory
  549.    --------------------------------------------------------------------------}
  550.  
  551.    DOS_Memory := MemW [$0000:$0413];
  552.    UsedMemory := PrefixSeg SHR 6;
  553.    Regs.AH := $88;
  554.    Intr ($15, Regs);
  555.    ExtendedMem := (((Regs.Flags AND FCarry) = 0) AND (Regs.AX <> 0));
  556.    IF ExtendedMem THEN
  557.       ExtendedMemSize := Regs.AX
  558.    ELSE IF (Typ = $FC) OR ((Typ >= $F5) AND (Typ <= $F8)) THEN BEGIN
  559.       Port [$70] := $30;
  560.       Dummy := Port [$71];
  561.       Port [$70] := $31;
  562.       ExtendedMemSize := Port [$71] * 256 + Dummy;
  563.       ExtendedMem := ExtendedMemSize > 0;
  564.       END;
  565.    ExpandedMem := EMM_Installed;
  566.    EMS_Base := 0;
  567.    IF ExpandedMem THEN BEGIN
  568.       ExpandedMemSize := EMS_Memory;
  569.       EMS_Version := GetEMSVersion;
  570.       EMS_Base    := GetEMSBase;
  571.       END;
  572.  
  573.    Segment := 0;
  574.    SystemMemory := 0;
  575.    MemExists := TRUE;
  576.    WHILE MemExists AND (Segment < CardMemBegin [GraphCard]) DO BEGIN
  577.       Inline ($FA);                         { disable interupts }
  578.       SaveByte := Mem [Segment:0];
  579.       Mem [Segment:0] := $55;
  580.       Dummy := Mem [Segment:0];
  581.       MemExists := (Dummy = $55);
  582.       Mem [Segment:0] := $AA;
  583.       Dummy := Mem [Segment:0];
  584.       MemExists := MemExists AND (Dummy = $AA);
  585.       Mem [Segment:0] := SaveByte;
  586.       Inline ($FB);                         { enable interupts }
  587.       Inc (Segment, $400);
  588.       IF MemExists THEN
  589.          Inc (SystemMemory, 16);
  590.    END;
  591.  
  592.    {-------------------------------------------------------------------------
  593.      determine diskette drives
  594.    --------------------------------------------------------------------------}
  595.  
  596.    DOS_Drives := 0;
  597.    DriveStr := '  (';
  598.    Regs.AH := $19;
  599.    Intr ($21, Regs);
  600.    DefaultDr := Regs.AL;
  601.    FOR L:=0 TO 8 DO BEGIN
  602.       Regs.AH := $0e;
  603.       Regs.DX := L;
  604.       Intr ($21, Regs);
  605.       Regs.AH := $19;
  606.       Intr ($21, Regs);
  607.       IF (Regs.AL = Regs.DX) THEN BEGIN
  608.          Inc (DOS_Drives);
  609.          DriveStr := DriveStr + Chr (L+65) + ':, ';
  610.          END;
  611.    END;
  612.    Regs.AH := $0e;
  613.    Regs.DX := DefaultDr;
  614.    Intr ($21, Regs);
  615.    IF DriveStr [Length(DriveStr)-1] = ',' THEN
  616.       Dec (DriveStr [0], 2);
  617.    DriveStr := DriveStr + ')';
  618.  
  619.    DriveByte := 0;
  620.    IF Typ = $FC THEN BEGIN
  621.       Port [$70] := $10;
  622.       DriveByte := Port [$71];
  623.       Drive1 := DriveByte AND 15;
  624.       NrDD := 0;
  625.       NrHD := 0;
  626.       Nr3DD := 0;
  627.       Nr3HD := 0;
  628.       CASE Drive1 OF
  629.           1: Inc (NrDD);
  630.           2: Inc (NrHD);
  631.           3: Inc (Nr3DD);
  632.           4: Inc (Nr3HD);
  633.       END;
  634.       Drive2 := DriveByte SHR 4;
  635.       CASE Drive2 OF
  636.           1: Inc (NrDD);
  637.           2: Inc (NrHD);
  638.           3: Inc (Nr3DD);
  639.           4: Inc (Nr3HD);
  640.       END;
  641.    END;
  642.  
  643.    DiskTypeStr := '';
  644.    IF DriveByte <> 0 THEN BEGIN
  645.       DiskTypeStr := '  (';
  646.       IF NrDD <> 0 THEN
  647.          DiskTypeStr := DiskTypeStr + Char (48+NrDD) + ' x 360 kB 5¼", ';
  648.       IF NrHD <> 0 THEN
  649.          DiskTypeStr := DiskTypeStr + Char (48+NrHD) + ' x 1.2 MB 5¼", ';
  650.       IF Nr3DD <> 0 THEN
  651.          DiskTypeStr := DiskTypeStr + Char (48+Nr3DD) + ' x 720 kB 3½", ';
  652.       IF Nr3HD <> 0 THEN
  653.          DiskTypeStr := DiskTypeStr + Char (48+Nr3HD) + ' x 1.44 MB 3½", ';
  654.       Dec (DiskTypeStr[0], 2);
  655.       DiskTypeStr := DiskTypeStr + ')';
  656.       END;
  657.  
  658.    {-------------------------------------------------------------------------
  659.      determine hard disks
  660.    --------------------------------------------------------------------------}
  661.  
  662.    Regs.AH := $08;                          { get drive parameters }
  663.    Regs.DL := $80;                          { of first harddisk }
  664.    Intr ($13, Regs);                        { BIOS disk interupt }
  665.    IF (Regs.Flags AND FCarry) <> 0 THEN     { error indicates no harddisk }
  666.       NrOfHardDisks := 0
  667.    ELSE
  668.       NrOfHardDisks := Regs.DL;             { else # of harddisk is returned }
  669.  
  670.    FOR L := 1 TO 4 DO BEGIN
  671.       Regs.AH := $10;                       { test drive ready }
  672.       Regs.DL := $7F + L;                   { of harddisk # L }
  673.       Intr ($13, Regs);                     { BIOS disk interupt }
  674.       IF ((Regs.Flags AND FCarry) <> 0) OR  { no error indicates drive exists }
  675.          (NrOfHardDisks = 0) THEN
  676.          Valid [$7F+L] := FALSE
  677.       ELSE BEGIN
  678.          Valid [$7F+L] := TRUE;
  679.          Dec (NrOfHardDisks);
  680.          END;
  681.    END;
  682.  
  683.    NrOfHardDisks := 0;
  684.    FOR L := $80 TO $83 DO BEGIN
  685.       IF Valid [L] THEN
  686.          Inc (NrOfHardDisks);
  687.    END;
  688.  
  689.  
  690.    {-------------------------------------------------------------------------
  691.      determine type of processor and coprocessor
  692.    --------------------------------------------------------------------------}
  693.  
  694.    IF MonoChromMode THEN
  695.       ScreenAddr := Ptr ($B000,0000)
  696.    ELSE
  697.       ScreenAddr := Ptr ($B800,0000);
  698.  
  699.    IF Debug THEN BEGIN
  700.       WriteLn;
  701.       FillChar (Result, SizeOf (ResultRec), 0);
  702.       Result.Speed287 := 1;
  703.       END;
  704.  
  705.    SpeedTest (Word (NOT Debug), Word(ExtendedMem), Word(ExpandedMem), MoveBuffer,
  706.               Ptr (EMS_Base, 0), ScreenAddr, Result);
  707.  
  708.    IF Debug THEN BEGIN
  709.       WriteLn ('RawMoveWTime: ', MoveWtime);
  710.       WriteLn ('RawMoveDTime: ', MoveDTime);
  711.       WriteLn ('CPU-Type:     ', CPUType);
  712.       WriteLn ('AAMTime:      ', AAMTime DIV 4);
  713.       WriteLn ('MoveBTime:    ', MoveBtime);
  714.       ReadLn;
  715.       END;
  716.  
  717.    CPU := Processor (CPUType);
  718.    Weitek := (NDPType AND $80) <> 0;
  719.    NDPType := NDPType AND $7F;            { clear Weitek flag }
  720.    ProcessorType := CPU_Name [CPU];
  721.  
  722.    IF NOT (CPU >= i286) THEN
  723.       ExtendedMem := FALSE;
  724.  
  725.    CacheSize (Debug, CPU > i286, FirstLevel, SecondLevel, CacheThru, Cache2Thru, MemThru);
  726.  
  727.  
  728.    {-------------------------------------------------------------------------
  729.      determine speed
  730.    --------------------------------------------------------------------------}
  731.  
  732.    Frequency  := 200 * AAM_Time [CPU] * ClockFreq / AAMTime;
  733.    MoveTakte  := MoveBTime * Frequency / (ClockFreq * 5000);
  734.    MoveWTakte := MoveWTime * Frequency / (ClockFreq * 5000);
  735.    IF CPU >= i386 THEN BEGIN
  736.       MoveWTime := MoveDTime DIV 2;   { because twice the # of words were moved}
  737.       END;
  738.    IF Debug THEN BEGIN
  739.       WriteLn ('MoveWTime:    ', MoveWtime);
  740.       WriteLn ('MoveDTime:    ', MoveDTime);
  741.       WriteLn ('MoveTakte:    ', MoveTakte:0:2);
  742.       WriteLn ('MoveTimeCPU:  ', MoveTime [CPU]);
  743.       WriteLn ('LFaktor:      ', LFaktor [CPU]);
  744.       WriteLn ('Frequency:    ', Frequency);
  745.       END;
  746.    ThruPut    := ClockFreq * 10000 / MoveWTime;
  747.    IF CPU >= i386 THEN
  748.       DataWidth := 32
  749.    ELSE
  750.       DataWidth:= 16;
  751.    WaitStates := (((((DataWidth DIV 8) * Frequency / (MoveTime [CPU] * 1024)) / MemThru)
  752.                  * MoveTime [CPU] - MoveTime [CPU]) * 0.5);
  753.    Index      := LFaktor[CPU] * Frequency/4.7e6 * (MoveTime [CPU] / MoveTakte);
  754.    FillTakte  := ScreenFillTime * Frequency / (ClockFreq * 5000);
  755.    IF Debug THEN BEGIN
  756.       WriteLn ('ScreenFillTim:', ScreenFillTime);
  757.       WriteLn ('FillTakte:    ', FillTakte);
  758.       WriteLn ('Index:        ', Index);
  759.       WriteLn ('BIOSWriteTime:', BIOSWriteTime);
  760.       END;
  761.    ScreenWaits:= Trunc (FillTakte - FillTime [CPU] + 0.1);
  762.  
  763.    IF Debug THEN BEGIN
  764.       WriteLn ('Stat87:       ', NDPType);
  765.       WriteLn ('Speed87:      ', Speed87);
  766.       WriteLn ('Speed287:     ', Speed287);
  767.       WriteLn ('Freq287:      ', 1e-6 * 7690 * ClockFreq /Speed287 :0:2);
  768.       END;
  769.  
  770.  
  771.    IF ExpandedMem THEN BEGIN
  772.       IF CPU >= i386 THEN
  773.          EMS_Thruput := ClockFreq * 16000 / EMS_Time
  774.       ELSE
  775.          EMS_ThruPut := ClockFreq * 10000 / EMS_Time;
  776.       END;
  777.  
  778.  
  779.    IF ExtendedMem THEN
  780.       Ext_ThruPut := ClockFreq * 10000 / Ext_Time;
  781.  
  782.    CASE NDPType OF             { 40 * # of clock cycles for FSQRT }
  783.    {EMC87}  27: Frequency87 := 1470 * ClockFreq / Speed287;  { 36 clocks }
  784.    {83S87}  26: Frequency87 := 3040 * ClockFreq / Speed287;  { 76 clocks magazine}
  785.    {387+}   25: Frequency87 := 2880 * ClockFreq / Speed287;  { 76 clocks magazine}
  786.    {82S87}  24: Frequency87 := 3040 * ClockFreq / Speed287;  { 76 clocks magazine}
  787.    {82S87}  23: Frequency87 := 3040 * ClockFreq / Speed287;  { 72 clocks meas.}
  788.    {486}    22: Frequency87 := 3320 * ClockFreq / Speed287;  { 83 clocks meas. }
  789.    {RapidCAD}21:Frequency87 := 3320 * ClockFreq / Speed287;  { 83 clocks }
  790.    {387DX}  20: Frequency87 := 4480 * ClockFreq / Speed287;  { 112 clocks meas.}
  791.    {38700sx}19: Frequency87 := 2200 * ClockFreq / Speed287;  { 55 clocks }
  792.    {38700DX}18: Frequency87 := 2040 * ClockFreq / Speed287;  { 52 clocks }
  793.    {83C87sx}17: Frequency87 := 3640 * ClockFreq / Speed287;  { 91 clocks magazine}
  794.    {83C87}  16: Frequency87 := 3440 * ClockFreq / Speed287;  { 86 clocks meas.}
  795.    {83S87}  15: Frequency87 := 1880 * ClockFreq / Speed287;  { 47 clocks meas.}
  796.    {83D87}  14: Frequency87 := 1470 * ClockFreq / Speed287;  { 36 clocks meas.}
  797.    {82S87}  13: Frequency87 := 1880 * ClockFreq / Speed287;  { 47 clocks }
  798.    {82S87}  12: Frequency87 := 1880 * ClockFreq / Speed287;  { 47 clocks }
  799.    {3C87sx} 11: Frequency87 := 2280 * ClockFreq / Speed287;  { 57 clocks DataSheet }
  800.    {3C87}   10: Frequency87 := 2240 * ClockFreq / Speed287;  { 57 clocks meas.}
  801.    {2C87}  8,9: Frequency87 := (1970 * ClockFreq / Speed287) * (0.928 + Index/65.0);  { 49 Takte }
  802.    {387sx}   7: Frequency87 := 5160 * ClockFreq / Speed287;  { 129 clocks }
  803.    {387}     6: Frequency87 := 5120 * ClockFreq / Speed287;  { 128 clocks meas. }
  804.    {287XL}   5: Frequency87 := 5440 * ClockFreq / Speed287;  { 136 clocks}
  805.    {287}     4: Frequency87 := (7690 * ClockFreq / Speed287) * (0.928 + Index/65.0);  {183 clocks meas.}
  806.    {80C187}  3: Frequency87 := 5440 * ClockFreq / Speed87;   { 136 clocks }
  807.    {8087}    2: Frequency87 := 7440 * ClockFreq / Speed87;   { 186 clocks meas.}
  808.    END;
  809.  
  810.    (* Correction for faster execution of coprocessor instructions with 486DLC *)
  811.  
  812.    IF (CPU = c486dlc) THEN
  813.       Frequency87 := Frequency87 / 1.055;
  814.  
  815.    Regs.AH := $30;
  816.    Intr ($21, Regs);
  817.    Version := Regs.AL+Regs.AH / 100.0;
  818.  
  819.    {---------------------------------------------------------------------------
  820.      speed of screen output
  821.    ---------------------------------------------------------------------------}
  822.  
  823.    TestStr := '                                                $';
  824.    SegTest := Seg (TestStr);
  825.    OfsTest := Ofs (TestStr)+1;
  826.    Start := Clock;
  827.       inline ($b9/$14/$00/
  828.               $b4/$02/
  829.               $b7/$00/
  830.               $b6/$1a/
  831.               $b2/$01/
  832.               $cd/$10/
  833.               $b4/$09/
  834.               $8e/$1e/SegTest/
  835.               $8b/$16/OfsTest/
  836.               $cd/$21/
  837.               $e2/$e8);
  838.    DosWriteTime := Clock - Start;
  839.  
  840.    IF Debug THEN BEGIN
  841.       GotoXY (1,25);
  842.       WriteLn ('DOSWriteTime: ', DOSWriteTime);
  843.       REPEAT UNTIL KeyPressed;
  844.       Read (Ch);
  845.       END;
  846.  
  847.    BIOSSpeed  := 20 * ClockFreq / BiosWriteTime;
  848.    DOSSpeed   := 1e6 / DOSWriteTime;
  849.  
  850.  
  851.    Regs.AX := $0C0F;    { clear keyboard buffer }
  852.    Intr ($21, Regs);
  853.    TestStr := 'n$'#8#8#8#8#8#8#8'       ';
  854.    Regs.AH := 9;
  855.    Regs.DS := Seg (TestStr);
  856.    Regs.DX := Ofs (TestStr)+1;
  857.    Intr ($21, Regs);
  858.    Regs.AH := $B;
  859.    Intr ($21, Regs);
  860.    ANSIPresent := (Regs.AL = $FF);
  861.    Regs.AX := $0C0F;    { clear keyboard buffer }
  862.    Intr ($21, Regs);
  863.  
  864.    FreeMem (MoveBuffer, 20000);
  865.    Emu := (Test8087 = 0) OR (NDPType < 2);
  866.  
  867.  
  868.    {-------------------------------------------------------------------------
  869.      output page 1
  870.    --------------------------------------------------------------------------}
  871.  
  872.    ClrScr;
  873.    WriteLn    ('══ public domain version ═══ COMPTEST  2.57 ═══════════════════════ '+'Page 1 ═══');
  874.    WriteLn;
  875.    WriteLn    ('computer type: ':37, ComputerType);
  876.    WriteLn    ('CPU: ':37, ProcessorType);
  877.    WriteLn    ('clock frequency: ':37, Frequency/1e6:0:2, ' MHz');
  878.    WriteLn    ('bus width: ':37, BusWidth[CPU], ' bit');
  879.    Write      ('CPU-cache: ':37);
  880.    IF FirstLevel <> 0 THEN BEGIN
  881.       Write ('1. level: ', FirstLevel, ' kB');
  882.       IF SecondLevel = 0 THEN
  883.          WriteLn
  884.       ELSE
  885.          WriteLn (', 2. level: ', SecondLevel, ' kB')
  886.       END
  887.    ELSE
  888.       WriteLn ('NOT FOUND');
  889.    WriteLn;
  890.    IF FirstLevel <> 0 THEN BEGIN
  891.       Write    ('maximum RAM thruput (without cache): ':37, MemThru:0:0, ' kB/s');
  892.       WriteLn    (' (effective wait states: ', Waitstates:0:1, ')');
  893.       Write   ('CPU-cache thruput: ':37, '1. level: ', CacheThru:0:0, ' kB/s');
  894.       IF SecondLevel <> 0 THEN
  895.          WriteLn (', 2. level: ', Cache2Thru:0:0, ' kB/s');
  896.       END
  897.    ELSE BEGIN
  898.       Write    ('maximum RAM-thruput: ':37, MemThru:0:0, ' kB/s');
  899.       WriteLn  (' (effective wait-states: ', Waitstates:0:1, ')');
  900.       END;
  901.    WriteLn;
  902.    WriteLn    ('system memory: ':37, SystemMemory:0, ' kB');
  903.    WriteLn    ('available to DOS: ':37, DOS_Memory:0, ' kB');
  904.    WriteLn    ('permanently used by DOS and TSRs: ':37, UsedMemory:0, ' kB');
  905.    WriteLn;
  906.    Write      ('extended memory: ':37);
  907.    IF ExtendedMem THEN
  908.       WriteLn (ExtendedMemSize:0, ' kB (INT 15h thruput: ', Ext_Thruput/1024:0:0, ' kB/s)')
  909.    ELSE
  910.       WriteLn ('NOT FOUND');
  911.    Write      ('expanded memory: ':37);
  912.    IF ExpandedMem THEN
  913.       WriteLn (ExpandedMemSize:0, ' kB (EMS ', EMS_Version, ', thruput: ', EMS_ThruPut/1024:0:0, ' kB/s)')
  914.    ELSE
  915.       WriteLn ('NOT FOUND');
  916.    WriteLn;
  917.    Write      ('other RAM: ':37);
  918.    SearchExtraRAM (FALSE);
  919.    WriteLn;
  920.    Write      ('BIOS-extensions: ':37);
  921.    SearchROM (FALSE);
  922.    WriteLn;
  923.    WriteLn    ('════════════════════════════ COMPTEST  2.57 ════════════ (c) 1988-1992 N.J. ══');
  924.    Write      ('Press a key for page 2');
  925.  
  926.    Ch := ReadKey;
  927.    ClrScr;
  928.    WriteLn    ('════════════════════════════ COMPTEST  2.57 ═══════════════════════ Page 2 ═══');
  929.    WriteLn;
  930.    WriteLn    ('parallel ports: ':37, NrParallelPorts:1);
  931.    Write      ('serial ports: ':37, NrSerialPorts:1);
  932.    Dummy := 0;
  933.    IF NrSerialPorts <> 0 THEN BEGIN
  934.       Write (' (');
  935.       FOR L := 1 TO 4 DO BEGIN
  936.          IF SIOType [L] <> 0 THEN BEGIN
  937.             Inc (Dummy);
  938.             Write ('COM', L, ': ', SIOTypeStr [SIOType[L]]);
  939.             IF Dummy <> NrSerialPorts THEN
  940.                Write (', ');
  941.             END;
  942.       END;
  943.       WriteLn (')');
  944.       END;
  945.  
  946.    Write ('mathematical coprocessor: ':37);
  947.    IF NDPType > 0 THEN BEGIN
  948.       Write (CoProcessor [NDPType]);
  949.       IF NDPType > 1 THEN
  950.          Write (' (clock frequency:', Frequency87/1e6:0:2, ' MHz)')
  951.       END;
  952.    IF Weitek THEN BEGIN
  953.       IF NDPType > 1 THEN BEGIN
  954.          Writeln;
  955.          Write ('':37);
  956.          END;
  957.       IF CPU >= i486 THEN
  958.          Writeln ('Weitek 4167')
  959.       ELSE
  960.          Writeln ('Weitek 3167 or 1167');
  961.       END;
  962.    IF (NDPType = 0) AND (NOT Weitek) THEN
  963.       WriteLn (CoProcessor [NDPType])
  964.    ELSE IF (NOT Weitek) THEN
  965.       WriteLn;
  966.  
  967.    WriteLn    ('mouse: ':37, Installed [MousePresent]);
  968.    WriteLn    ('games adaptor: ':37, Installed [GamesAdaptor]);
  969.    Writeln;
  970.    WriteLn    ('DOS drives: ':37, DOS_Drives:0, DriveStr);
  971.    Write      ('floppy drives: ':37, NrOfFloppies:0);
  972.    WriteLn    (DiskTypeStr);
  973.    WriteLn    ('hard disks: ':37, NrOfHardDisks:0);
  974.    WriteLn;
  975.    Write      ('graphics card: ':37, CardName [GraphCard]);
  976.    IF GraphCard = EGA THEN
  977.       WriteLn (' w/', EGAMem:4, ' kB')
  978.    ELSE
  979.       WriteLn;
  980.    WriteLn    ('video-RAM wait states: ':37, ScreenWaits);
  981.    WriteLn    ('speed of video output via BIOS: ':37, BIOSSpeed:0:0, ' characters/sec');
  982.    Write      ('speed of video output via DOS: ':37, DOSSpeed:0:0, ' characters/sec (');
  983.    IF ANSIPresent THEN
  984.      Write  ('with')
  985.    ELSE
  986.      Write  ('without');
  987.    WriteLn  (' ANSI driver)');
  988.    WriteLn    ('DOS version: ':37, Version:3:2);
  989.    WriteLn;
  990.    Write      ('Dhrystones/second: ':37);
  991.    Dhrys := Dhrystones (Index);
  992.    Write     (Dhrys:0:1);
  993.    WriteLn   (' (CPU: ', Dhrys/3.6464E+2:0:1, '-fold of XT)');
  994.    Write      ('Double-Precision Kilowhetstones: ':37);
  995.    Whets := Whetstone (Emu, Index);
  996.    Write      (Whets:0:1);
  997.    IF Emu THEN
  998.       WriteLn (' (emulator: ', Whets/4.9169E+0:0:1, '-fold of XT)')
  999.    ELSE
  1000.       WriteLn (' (FPU: ', Whets/9.9087E+1:0:1, '-fold of XT w/ 8087)');
  1001.    Write     ('Double-Precision MFLOPS: ':37);
  1002.    MegaFlops := MFlops (Emu, Index);
  1003.    Write     (MegaFlops:0:3);
  1004.    IF Emu THEN
  1005.       WriteLn (' (emulator: ', MegaFlops/6.5242E-4:0:1, '-fold of XT)')
  1006.    ELSE
  1007.       WriteLn (' (FPU: ', MegaFlops/1.2446E-2:0:1, '-fold of XT w/ 8087)');
  1008.    WriteLn;
  1009.    WriteLn    ('════════════════════════════ COMPTEST  2.57 ════════════ (c) 1988-1992 N.J. ══');
  1010.    IF (NOT Weitek) THEN
  1011.       WriteLn;
  1012.    END; {with}
  1013.  
  1014.    IF Debug THEN BEGIN
  1015.       WriteLn ('Dhry: ', Dhrys);
  1016.       WriteLn ('Whet: ', Whets);
  1017.       WriteLn ('MFlop:', MegaFlops);
  1018.       Ch := ReadKey;
  1019.       END;
  1020.  
  1021.    IF NrOfHardDisks <> 0 THEN BEGIN
  1022.       Write   ('Test hard disk(s) (Y/N) ? ');
  1023.       Ch := ReadKey;
  1024.       IF UpCase (Ch) <> 'Y' THEN
  1025.          NrOfHardDisks := 0;
  1026.       END;
  1027.  
  1028.    IF (NrOfHardDisks > 0) THEN BEGIN
  1029.  
  1030.      ClrScr;
  1031.      WriteLn    ('════════════════════════════ COMPTEST  2.57 ═══════════════════════ Page 3 ═══');
  1032.  
  1033.      FOR L := $80 TO $83 DO BEGIN
  1034.  
  1035.        IF Valid [L] THEN BEGIN
  1036.  
  1037.           WriteLn;
  1038.  
  1039.           Regs.AH := $08;
  1040.           Regs.DL := L;
  1041.           Intr ($13, Regs);
  1042.           Sectors [L]   := Regs.CL AND $3F;
  1043.           Cylinders [L] := Word (Regs.CL AND $C0) * 4 + Regs.CH + 1;
  1044.           Heads [L]     := Regs.DH + 1;
  1045.           CylSize [L]   := LongInt (Sectors [L]) * Heads [L] * 512;
  1046.  
  1047.           ReserveMem;
  1048.  
  1049.           BufOff := Ofs (BufPtr^);
  1050.           BufSeg := Seg (BufPtr^);
  1051.  
  1052.           Regs.CX := 1;
  1053.           Regs.DL := L;
  1054.           Regs.DH := 0;
  1055.           Regs.AX := $0201;
  1056.           Regs.ES := BufSeg;
  1057.           Regs.BX := BufOff;
  1058.           Intr ($13, Regs);
  1059.  
  1060.           DOSCylinders [L] := 0;
  1061.           Dummy := $1C5;
  1062.           WHILE (Dummy < $200) AND ((BufPtr^[$1FF] * 256 + BufPtr^[$200]) = $55AA) DO BEGIN
  1063.              IF ((BufPtr^[Dummy] AND $C0) * 4 + BufPtr^[Dummy+1] + 1) > DOSCylinders [L] THEN
  1064.                  DOSCylinders [L]:= (BufPtr^[Dummy] AND $C0) * 4 + BufPtr^[Dummy+1]+1;
  1065.              Inc (Dummy, $10);
  1066.           END;
  1067.  
  1068.           FreeMem (BufPtr, Word(CylSize [L]+16));
  1069.           FreeMem (DummyPtr, FillSize);
  1070.  
  1071.           IF DOSCylinders [L] > Cylinders [L] THEN
  1072.              Cylinders [L] := DOSCylinders [L];
  1073.           SPC         := Sectors [L] * Heads [L];
  1074.           CylSize [L] := LongInt (512) * SPC;
  1075.           Capacity [L]:= CylSize [L] * Cylinders [L];
  1076.  
  1077.           ReserveMem;
  1078.  
  1079.           Write   ('hard disk ', L-$7F:1);
  1080.           WriteLn ('cylinders: ':26, Cylinders[L]);
  1081.           WriteLn ('read/write heads: ':37, Heads[L]);
  1082.           WriteLn ('sectors per track: ':37, Sectors[L]);
  1083.           WriteLn ('storage capacity: ':37, Capacity[L],  ' Byte (',Capacity[L] / 1048576.0:0:2,' MB)');
  1084.           WriteLn;
  1085.  
  1086.   {-------------------------------------------------------------------------
  1087.      determine track-to-track time
  1088.    --------------------------------------------------------------------------}
  1089.  
  1090.           Write   ('track-to-track seek time: ':37);
  1091.           Start := Clock;
  1092.           FOR Track := 0 TO Cylinders[L]-1 DO BEGIN
  1093.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1094.                      $a1/Track/            { mov ax, Track }
  1095.                      $88/$c5/              { mov ch, al }
  1096.                      $25/$00/$03/          { and ax, $300 }
  1097.                      $d1/$e8/              { shr ax, 1 }
  1098.                      $d1/$e8/              { shr ax, 1 }
  1099.                      $0d/$01/$00/          { or  ax, Sector }
  1100.                      $88/$c1/              { mov cl, al }
  1101.                      $b4/$0c/              { mov ah, SeekFunc }
  1102.                      $cd/$13);             { int BIOS-DiskIO }
  1103.           END;
  1104.           TrackToTrack [L] := Int (((Clock-Start) / Cylinders[L]) * 10 + 0.5) / 10;
  1105.           WriteLn (TrackToTrack [L]:6:2, ' ms');
  1106.  
  1107.   {-------------------------------------------------------------------------
  1108.      determine average acces time
  1109.    --------------------------------------------------------------------------}
  1110.  
  1111.           Write   ('average seek time: ':37);
  1112.           Dummy := 2 * Cylinders [L] DIV 3;
  1113.           Start := Clock;
  1114.           FOR Track := 1 TO 40 DO BEGIN
  1115.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1116.                      $a1/Dummy/            { mov ax, Track }
  1117.                      $88/$c5/              { mov ch, al }
  1118.                      $25/$00/$03/          { and ax, $300 }
  1119.                      $d1/$e8/              { shr ax, 1 }
  1120.                      $d1/$e8/              { shr ax, 1 }
  1121.                      $0d/$01/$00/          { or  ax, Sector }
  1122.                      $88/$c1/              { mov cl, al }
  1123.                      $b4/$0c/              { mov ah, SeekFunc }
  1124.                      $cd/$13);             { int BIOS-DiskIO }
  1125.              Dummy := Cylinders [L] - Dummy;
  1126.           END;
  1127.           AverageAccess [L] := Int ((Clock - Start) * 0.25 + 0.5) / 10;
  1128.           WriteLn (AverageAccess [L]:6:2, ' ms');
  1129.  
  1130.    {-------------------------------------------------------------------------
  1131.      maximum access time
  1132.    --------------------------------------------------------------------------}
  1133.  
  1134.           Write   ('maximum seek time: ':37);
  1135.           Dummy := 0;
  1136.           Start := Clock;
  1137.           FOR Track := 1 TO 25 DO BEGIN
  1138.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1139.                      $a1/Dummy/            { mov ax, Track }
  1140.                      $88/$c5/              { mov ch, al }
  1141.                      $25/$00/$03/          { and ax, $300 }
  1142.                      $d1/$e8/              { shr ax, 1 }
  1143.                      $d1/$e8/              { shr ax, 1 }
  1144.                      $0d/$01/$00/          { or  ax, Sector }
  1145.                      $88/$c1/              { mov cl, al }
  1146.                      $b4/$0c/              { mov ah, SeekFunc }
  1147.                      $cd/$13);             { int BIOS-DiskIO }
  1148.              Dummy := (Cylinders[L]-1) - Dummy;
  1149.           END;
  1150.           MaximumAccess [L]:= Int ((Clock-Start) * 0.04 + 0.5);
  1151.           WriteLn (MaximumAccess[L]:6:2, ' ms');
  1152.  
  1153.  
  1154.    {-------------------------------------------------------------------------
  1155.      determine maximum thruput
  1156.    --------------------------------------------------------------------------}
  1157.  
  1158.          IF Debug THEN BEGIN
  1159.             WriteLn ('SPC: ', SPC);
  1160.             WriteLn ('BufSeg: ', Hex(BufSeg));
  1161.             WriteLn ('BufOff: ', Hex(BufOff));
  1162.             ReadLn;
  1163.             END;
  1164.  
  1165.           Write   ('maximum thruput: ':37);
  1166.           Delay (200);
  1167.           Dummy := 0;
  1168.           Start := Clock;
  1169.           FOR Track := 1 TO 15 DO BEGIN
  1170.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1171.                      $a1/Dummy/            { mov ax, 0 }
  1172.                      $88/$c5/              { mov ch, al }
  1173.                      $25/$00/$03/          { and ax, $300 }
  1174.                      $d1/$e8/              { shr ax, 1 }
  1175.                      $d1/$e8/              { shr ax, 1 }
  1176.                      $0d/$01/$00/          { or  ax, Sector }
  1177.                      $88/$c1/              { mov cl, al }
  1178.                      $8b/$1e/BufOff/       { mov bx, BufOff }
  1179.                      $8e/$06/BufSeg/       { mov es, BufSeg }
  1180.                      $a1/SPC/              { mov ax, SectorPerTrack }
  1181.                      $b4/$02/              { mov ah, ReadFunc }
  1182.                      $cd/$13);             { int BIOS-DiskIO }
  1183.           END;
  1184.           DiskThruPut [L] := 15000 * (CylSize [L] DIV 1024) / (Clock-Start);
  1185.           Delay (200);
  1186.           Dummy := Cylinders [L] - 1;
  1187.           Head1 := Heads [L] - ((SPC + Sectors[L] - 1) DIV Sectors [L]);
  1188.           ErrByte := 0;
  1189.           FOR Track := 1 TO 16 DO BEGIN
  1190.              IF Track = 2 THEN
  1191.                 Start := Clock;
  1192.              Inline ($8b/$16/L/            { mov dx, Drive }
  1193.                      $8a/$36/Head1/        { mov dh, Head }
  1194.                      $a1/Dummy/            { mov ax, Track}
  1195.                      $88/$c5/              { mov ch, al }
  1196.                      $25/$00/$03/          { and ax, $300 }
  1197.                      $d1/$e8/              { shr ax, 1 }
  1198.                      $d1/$e8/              { shr ax, 1 }
  1199.                      $0d/$01/$00/          { or  ax, Sector }
  1200.                      $88/$c1/              { mov cl, al }
  1201.                      $8b/$1e/BufOff/       { mov bx, BufOff }
  1202.                      $8e/$06/BufSeg/       { mov es, BufSeg }
  1203.                      $a1/SPC/              { mov ax, SectorPerTrack }
  1204.                      $b4/$02/              { mov ah, ReadFunc }
  1205.                      $cd/$13/              { int BIOS-DiskIO }
  1206.                      $08/$26/ErrByte);     { or ErrByte, ah }
  1207.           END;
  1208.           Durchsatz := 15000 * (CylSize [L] DIV 1024) / (Clock-Start);
  1209.  
  1210.  
  1211.           IF Debug THEN BEGIN
  1212.              WriteLn;
  1213.              WriteLn ('thruput track 0: ', DiskThruput[L]);
  1214.              WriteLn ('thruput track ', Cylinders [L], ': ', Durchsatz);
  1215.              END;
  1216.  
  1217.           IF (ErrByte = 0)  AND (Durchsatz > DiskThruPut [L]) THEN
  1218.              DiskThruPut [L] := Durchsatz;
  1219.           Write   (DiskThruPut [L]:3:0, ' kB/sec');
  1220.  
  1221.  
  1222.    {--------------------------------------------------------------------------
  1223.      test if disk cache active
  1224.    --------------------------------------------------------------------------}
  1225.  
  1226.           Dummy := 2 * Cylinders [L] DIV 3;
  1227.           SPC := 16;
  1228.           FOR Track := 1 TO 10 DO BEGIN
  1229.              IF Track = 8 THEN
  1230.                 Start := Clock;
  1231.              Inline ($8b/$16/L/            { mov dx, Drive&Head }
  1232.                      $a1/Dummy/            { mov ax, Track }
  1233.                      $88/$c5/              { mov ch, al }
  1234.                      $25/$00/$03/          { and ax, $300 }
  1235.                      $d1/$e8/              { shr ax, 1 }
  1236.                      $d1/$e8/              { shr ax, 1 }
  1237.                      $0d/$01/$00/          { or  ax, Sector }
  1238.                      $88/$c1/              { mov cl, al }
  1239.                      $8b/$1e/BufOff/       { mov bx, BufOff }
  1240.                      $8e/$06/BufSeg/       { mov es, BufSeg }
  1241.                      $a1/SPC/              { mov ax, NrOfSectors }
  1242.                      $b4/$02/              { mov ah, ReadFunc }
  1243.                      $cd/$13);             { int BIOS-DiskIO }
  1244.              Dummy := Cylinders [L] - Dummy;
  1245.           END;
  1246.  
  1247.           CacheTstTime := Clock - Start;
  1248.  
  1249.           IF Debug THEN BEGIN
  1250.              WriteLn;
  1251.              WriteLn ('Cachetest: ', CacheTstTime);
  1252.              ReadLn;
  1253.              END;
  1254.  
  1255.           IF CPU < i286 THEN
  1256.              CacheOn [L] := CacheTstTime < 75 { 3 seeks, 24 KB read < 75 ms }
  1257.           ELSE
  1258.              CacheOn [L] := CacheTstTime < 50;{ 3 seeks, 24 KB read < 50 ms }
  1259.           IF CacheOn [L] THEN
  1260.              WriteLn (' (using disk cache)')
  1261.           ELSE
  1262.              WriteLn;
  1263.  
  1264.           FreeMem (BufPtr, Word(CylSize [L])+16);
  1265.           FreeMem (DummyPtr, FillSize);
  1266.           WriteLn;
  1267.        END;
  1268.  
  1269.        END;
  1270.        IF NrOfHardDisks = 1 THEN
  1271.           WriteLn (#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10#13#10);
  1272.        WriteLn    ('════════════════════════════ COMPTEST  2.57 ════════════ (c) 1988-1992 N.J. ══');
  1273.     END;
  1274.  
  1275.  
  1276.     IF (ParamCount > 0) AND (NOT Debug) OR (ParamCount > 1) AND Debug THEN BEGIN
  1277.       Assign  (Fil, ParamStr(1));
  1278.       Rewrite (Fil);
  1279.       WriteLn (Fil, '════════════════════════════ COMPTEST  2.57 ═══════════════════════ Page 1 ═══');
  1280.       WriteLn (Fil);
  1281.       WriteLn (Fil, 'computer type: ':37, ComputerType);
  1282.       WriteLn (Fil, 'CPU: ':37, ProcessorType);
  1283.       WriteLn (Fil, 'clock frequency: ':37, Frequency/1e6:0:2, ' Mhz');
  1284.       WriteLn (Fil, 'bus width: ':37, BusWidth[CPU], ' bit');
  1285.       Write   (Fil, 'CPU-cache: ':37);
  1286.       IF FirstLevel <> 0 THEN BEGIN
  1287.          Write (Fil, '1. level: ', FirstLevel, ' kB');
  1288.          IF SecondLevel = 0 THEN
  1289.             WriteLn (Fil)
  1290.          ELSE
  1291.             WriteLn (Fil, ', 2. level: ', SecondLevel, ' kB')
  1292.          END
  1293.       ELSE
  1294.          WriteLn (Fil, 'NOT FOUND');
  1295.       WriteLn (Fil);
  1296.       IF FirstLevel <> 0 THEN BEGIN
  1297.          Write    (Fil,'maximum RAM thruput (without cache): ':37, MemThru:0:0, ' kB/s');
  1298.          WriteLn  (Fil,' (effective wait states: ', Waitstates:0:1, ')');
  1299.          Write    (Fil,'CPU cache thruput: ':37, '1. level: ', CacheThru:0:0, ' kB/s');
  1300.          IF SecondLevel <> 0 THEN
  1301.             WriteLn (Fil,', 2. level: ', Cache2Thru:0:0, ' kb/s');
  1302.          END
  1303.       ELSE BEGIN
  1304.          Write    (Fil, 'maximum RAM thruput: ':37, MemThru:0:0, ' kB/s');
  1305.          WriteLn  (Fil, ' (effective wait states: ', Waitstates:0:1, ')');
  1306.       END;
  1307.       WriteLn (Fil);
  1308.       WriteLn (Fil, 'system memory: ':37, SystemMemory:0, ' kB');
  1309.       WriteLn (Fil, 'available for DOS: ':37, DOS_Memory:0, ' kB');
  1310.       WriteLn (Fil, 'permanently used by DOS and TSRs: ':37, UsedMemory:0, ' kB');
  1311.  
  1312.       WriteLn (Fil);
  1313.       Write   (Fil, 'extended memory: ':37);
  1314.       IF ExtendedMem THEN
  1315.          WriteLn (Fil, ExtendedMemSize:0, ' kB (INT 15h thruput: ', Ext_Thruput/1024:0:0, ' kB/s)')
  1316.       ELSE
  1317.          WriteLn (Fil, 'NOT FOUND');
  1318.       Write      (Fil, 'expanded memory: ':37);
  1319.       IF ExpandedMem THEN
  1320.          WriteLn (Fil, ExpandedMemSize:0, ' kB (EMS ', EMS_Version, ', thruput: ', EMS_ThruPut/1024:0:0, ' kB/s)')
  1321.       ELSE
  1322.          WriteLn (Fil, 'NOT FOUND');
  1323.       WriteLn (Fil);
  1324.       Write   (Fil, 'other RAM: ':37);
  1325.       SearchExtraRAM (TRUE);
  1326.       WriteLn (Fil);
  1327.       Write   (Fil, 'BIOS-extensions: ':37);
  1328.       SearchROM (TRUE);
  1329.       WriteLn (Fil);
  1330.       WriteLn (Fil, '════════════════════════════ COMPTEST  2.57 ════════════ (c) 1988-1992 N.J. ══');
  1331.       WriteLn (Fil);
  1332.       WriteLn (Fil, '════════════════════════════ COMPTEST  2.57 ═══════════════════════ Page 2 ═══');
  1333.       WriteLn (Fil);
  1334.       WriteLn (Fil, 'parallel ports: ':37, NrParallelPorts:1);
  1335.       Write   (Fil, 'serial ports: ':37, NrSerialPorts:1);
  1336.       Dummy := 0;
  1337.       IF NrSerialPorts <> 0 THEN BEGIN
  1338.          Write (Fil, ' (');
  1339.          FOR L := 1 TO 4 DO BEGIN
  1340.             IF SIOType [L] <> 0 THEN BEGIN
  1341.                Inc (Dummy);
  1342.                Write (Fil, 'COM', L, ': ', SIOTypeStr [SIOType[L]]);
  1343.                IF Dummy <> NrSerialPorts THEN
  1344.                   Write (Fil, ', ');
  1345.                END;
  1346.          END;
  1347.          WriteLn (Fil, ')');
  1348.          END;
  1349.  
  1350.    Write (Fil, 'mathematical coprocessor: ':37);
  1351.    IF Result.NDPType > 0 THEN BEGIN
  1352.       Write (Fil, CoProcessor [Result.NDPType]);
  1353.       IF Result.NDPType > 1 THEN
  1354.          Write (Fil, ' (clock frequency:', Frequency87/1e6:0:2, ' MHz)')
  1355.       END;
  1356.    IF Weitek THEN BEGIN
  1357.       IF Result.NDPType > 1 THEN BEGIN
  1358.          Writeln (Fil);
  1359.          Write (Fil, '':37);
  1360.          END;
  1361.       IF CPU >= i486 THEN
  1362.          Writeln (Fil, 'Weitek 4167')
  1363.       ELSE
  1364.          Writeln (Fil, 'Weitek 3167 or 1167');
  1365.       END;
  1366.    IF (Result.NDPType = 0) AND (NOT Weitek) THEN
  1367.       WriteLn (Fil, CoProcessor [Result.NDPType])
  1368.    ELSE IF (NOT Weitek) THEN
  1369.       WriteLn (Fil);
  1370.  
  1371.       WriteLn  (Fil, 'mouse: ':37, Installed [MousePresent]);
  1372.       WriteLn  (Fil, 'games adaptor: ':37, Installed [GamesAdaptor]);
  1373.       WriteLn  (Fil);
  1374.       WriteLn  (Fil, 'DOS drives: ':37, DOS_Drives:0, DriveStr);
  1375.       Write    (Fil, 'floppy drives: ':37, NrOfFloppies:0);
  1376.       WriteLn  (Fil, DiskTypeStr);
  1377.       WriteLn  (Fil, 'hard disks: ':37, NrOfHardDisks:0);
  1378.       WriteLn  (Fil);
  1379.       Write    (Fil, 'graphics card: ':37, CardName [GraphCard]);
  1380.       IF GraphCard = EGA THEN
  1381.          WriteLn (Fil, ' w/', EGAMem:4, ' kB')
  1382.       ELSE
  1383.          WriteLn (Fil);
  1384.       WriteLn  (Fil, 'video-RAM wait states: ':37, ScreenWaits);
  1385.       WriteLn  (Fil, 'speed of video output via BIOS: ':37, BIOSSpeed:0:0, ' characters/sec');
  1386.       Write    (Fil, 'speed of video output via DOS: ':37, DOSSpeed:0:0, ' characters/sec (');
  1387.       IF ANSIPresent THEN
  1388.          Write  (Fil, 'with')
  1389.       ELSE
  1390.          Write  (Fil, 'without');
  1391.       WriteLn   (Fil, ' ANSI driver)');
  1392.       WriteLn   (Fil, 'DOS version: ':37, Version:3:2);
  1393.       WriteLn   (Fil);
  1394.       Write     (Fil, 'Dhrystones/second: ':37);
  1395.       Write     (Fil, Dhrys:0:1);
  1396.       WriteLn   (Fil, ' (CPU: ', Dhrys/3.6464E+2:0:1, '-fold of XT)');
  1397.       Write     (Fil, 'Double-Precision Kilowhetstones: ':37);
  1398.       Write     (Fil, Whets:0:1);
  1399.       IF Emu THEN
  1400.          WriteLn (Fil, ' (emulator: ', Whets/4.9169E+0:0:1, '-fold of XT)')
  1401.       ELSE
  1402.          WriteLn (Fil, ' (FPU: ', Whets/9.7087E+1:0:1, '-fold of XT w/ 8087)');
  1403.       Write     (Fil, 'Double-Precision MFLOPS: ':37);
  1404.       Write     (Fil, MegaFlops:0:3);
  1405.       IF Emu THEN
  1406.          WriteLn (Fil, ' (emulator: ', MegaFlops/6.5242E-4:0:1, '-fold of XT)')
  1407.       ELSE
  1408.          WriteLn (Fil, ' (FPU: ', MegaFlops/1.2446E-2:0:1, '-fold of XT w/ 8087)');
  1409.       WriteLn   (Fil);
  1410.       WriteLn   (Fil, '════════════════════════════ COMPTEST  2.57 ══════════ (c) 1988-1992 N.J. ════');
  1411.       WriteLn   (Fil);
  1412.       IF NrOfHardDisks = 0 THEN
  1413.          Close (Fil)
  1414.       ELSE BEGIN
  1415.          WriteLn   (Fil, '════════════════════════════ COMPTEST  2.57 ═══════════════════════ Page 3 ═══');
  1416.          WriteLn   (Fil);
  1417.  
  1418.          FOR L := $80 TO $7F+NrOfHardDisks DO BEGIN
  1419.  
  1420.            Write   (Fil, 'hard disk ', L-$7F:1);
  1421.            WriteLn (Fil, 'cylinders: ':26, Cylinders[L]);
  1422.            WriteLn (Fil, 'read/write heads: ':37, Heads[L]);
  1423.            WriteLn (Fil, 'sectors per track: ':37, Sectors[L]);
  1424.            WriteLn (Fil, 'storage capacity: ':37, Capacity[L],  ' Byte (',Capacity[L] / 1048576.0:0:2,' MB)');
  1425.            WriteLn (Fil);
  1426.            WriteLn (Fil, 'track-to-track seek time: ':37, TrackToTrack [L]:6:2, ' ms');
  1427.            WriteLn (Fil, 'average seek time: ':37, AverageAccess [L]:6:2, ' ms');
  1428.            WriteLn (Fil, 'maximum seek time: ':37, MaximumAccess[L]:6:2, ' ms');
  1429.            Write   (Fil, 'maximum thruput: ':37, DiskThruPut [L]:3:0, ' kB/sec');
  1430.            IF CacheOn [L] THEN
  1431.               WriteLn (Fil, ' (using disk cache)')
  1432.            ELSE
  1433.               WriteLn (Fil);
  1434.            WriteLn (Fil);
  1435.            WriteLn (Fil);
  1436.  
  1437.         END;
  1438.  
  1439.         WriteLn (Fil, '════════════════════════════ COMPTEST  2.57 ════════════ (c) 1988-1992 N.J. ══');
  1440.         END;
  1441.       Close (Fil);
  1442.       END;
  1443.       IF IOResult <> 0 THEN
  1444.          BEGIN END;
  1445.       Write   ('COMPTEST terminated - press any key');
  1446.       Ch := ReadKey;
  1447.  
  1448. END.
  1449.